Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH1/SRC/RESIZE.FRM

Text File | 1996-01-04 | 5KB | 180 lines

VERSION 4.00
Begin VB.Form ResizeForm
   Caption         =   "Resize"
   ClientHeight    =   4140
   ClientLeft      =   1500
   ClientTop       =   1725
   ClientWidth     =   6690
   Height          =   4830
   Left            =   1440
   LinkTopic       =   "Form1"
   ScaleHeight     =   4140
   ScaleWidth      =   6690
   Top             =   1095
   Width           =   6810
   Begin VB.Label RedrawLabel
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   960
      TabIndex        =   1
      Top             =   285
      Width           =   855
   End
   Begin VB.Label RecalcLabel
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   960
      TabIndex        =   0
      Top             =   0
      Width           =   855
   End
   Begin VB.Label Label1
      Caption         =   "Calculations"
      Height          =   255
      Index           =   0
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   855
   End
   Begin VB.Label Label1
      Caption         =   "Draws"
      Height          =   255
      Index           =   1
      Left            =   0
      TabIndex        =   3
      Top             =   285
      Width           =   495
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
End
Attribute VB_Name = "ResizeForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

' Counts for recalculations and redraws.
Dim recalcs As Integer
Dim redraws As Integer

' Drawing parameters.
Dim x1 As Single    ' The center of the face.
Dim y1 As Single
Dim x2 As Single    ' The left eye's center.
Dim y2 As Single
Dim x3 As Single    ' The right eye's center.
Dim y3 As Single
Dim x4 As Single    ' The right pupil's center.
Dim y4 As Single
Dim x5 As Single    ' The right pupil's center.
Dim y5 As Single
Dim r1 As Single    ' The face's radius.
Dim r2 As Single    ' The mouth's radius.
Dim r3 As Single    ' The eyes' radii.
Dim r4 As Single    ' The pupils' radii.

' ***********************************************
' Recalculate drawing parameters. Make the face
' as large as possible while keeping a 10% margin
' around all edges.
' ***********************************************
Sub CalculateParameters()
Dim r4_2 As Single

    x1 = ScaleWidth / 2
    y1 = ScaleHeight / 2
    If x1 < y1 Then
        r1 = x1 * 0.9
    Else
        r1 = y1 * 0.9
    End If
    r2 = r1 * 0.7
    r3 = r1 * 0.2
    r4 = r3 * 0.5

    x2 = x1 - r2 * 0.7
    y2 = y1 - r2 * 0.5
    x3 = x1 + r2 * 0.7
    y3 = y2

    r4_2 = r4 / Sqr(2)
    x4 = x2 + r4_2
    y4 = y2 + r4_2
    x5 = x3 + r4_2
    y5 = y3 + r4_2

    ' Update the recalc count.
    recalcs = recalcs + 1
    RecalcLabel.Caption = Format$(recalcs)
End Sub

' ***********************************************
' Draw stuff on the form.
' ***********************************************
Sub DrawForm()
Const PI = 3.14159
Dim old_fill As Integer

    Cls                         ' Erase the form.
    Circle (x1, y1), r1         ' Face
    Circle (x1, y1), r2, , PI + 0.3, 2 * PI - 0.3 ' Smile
    Circle (x1, y1), r3         ' Nose
    Circle (x2, y2), r3         ' Left eye.
    Circle (x3, y3), r3         ' Right eye.

    old_fill = FillStyle
    FillStyle = vbSolid
    Circle (x4, y4), r4         ' Left pupil.
    Circle (x5, y5), r4         ' Right pupil.
    FillStyle = old_fill

    ' Update the redraw count.
    redraws = redraws + 1
    RedrawLabel.Caption = Format$(redraws)
End Sub
' ***********************************************
' Redraw the form.
' ***********************************************
Private Sub Form_Paint()
    DrawForm
End Sub
' ***********************************************
' If we are minimized, do nothing. Otherwise
' recompute the drawing parameters. Then if
' neither the height nor the width have
' increased, we are shrinking so redraw the form.
' ***********************************************
Private Sub Form_Resize()
Static wid As Single
Static hgt As Single

    ' If we're minimized, do nothing.
    If WindowState = vbMinimized Then Exit Sub

    ' If the size has changed, recalculate the
    ' drawing parameters. This will not happen if
    ' we are being restored after being minimized.
    If Width <> wid Or Height <> hgt Then _
        CalculateParameters

    ' If we are shrinking, redraw now.
    If Not (Width >= wid And Height >= hgt) Then _
        DrawForm

    ' Save the new width and height.
    wid = Width
    hgt = Height
End Sub


Private Sub mnuFileExit_Click()
    Unload Me
End Sub